home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / addelt.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  4.0 KB  |  121 lines
  1.       subroutine addelt(loce,loc,id,inodx,inodi,nnodi)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine adds an element to the nominal circuit definition
  5. c lists.
  6. c
  7. c spice version 2g.6  sccsid=tabinf 3/15/83
  8.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  9.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  10.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  11.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  12.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  13.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  14.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  15.      7   irowno,jcolno,nttbr,nttar,lvntmp
  16. c spice version 2g.6  sccsid=cirdat 3/15/83
  17.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  18.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  19. c spice version 2g.6  sccsid=flags 3/15/83
  20.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  21.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  22. c spice version 2g.6  sccsid=blank 3/15/83
  23.       common /blank/ value(200000)
  24.       integer nodplc(64)
  25.       complex cvalue(32)
  26.       equivalence (value(1),nodplc(1),cvalue(1))
  27. c
  28. c... inodx(1), inodi(1) are arrays (see subckt)
  29.       dimension inodx(1),inodi(1)
  30. c
  31.       dimension lnod(50),lval(50),nnods(50)
  32.       data lnod /10,14,16, 8,15,16,15,16,13, 8,
  33.      1           18,38,27,35, 8, 8,35, 5, 5, 5,
  34.      2            5, 5, 5, 5, 0, 0, 0, 0, 0, 0,
  35.      3           21,21,21,21,21,21,21,21,21,21,
  36.      4            8, 8, 8, 8, 8, 0, 0, 0, 0, 0 /
  37.       data lval / 5, 4, 4, 2, 1, 1, 1, 1, 4, 4,
  38.      1            3, 4, 4,16, 1, 1, 9, 2, 1, 1,
  39.      2           19,55,17,46, 0, 0, 0, 0, 0, 0,
  40.      3            1, 1, 1, 1, 1,17,17,17,17,17,
  41.      4            1, 1, 1, 1, 1, 0, 0, 0, 0, 0 /
  42.       data nnods / 2, 2, 2, 0, 2, 2, 2, 2, 2, 2,
  43.      1             2, 4, 3, 4, 4, 4, 4, 0, 1, 0,
  44.      2             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  45.      3             0, 0, 0, 0, 0, 0, 0, 0, 0, 0,
  46.      4             2, 2, 2, 0, 0, 0, 0, 0, 0, 0 /
  47. c
  48. c  copy integer part
  49. c
  50.       nword=lnod(id)-3
  51.       if (nword.le.0) go to 10
  52.       call copy4(nodplc(loc+2),nodplc(loce+2),nword)
  53. c
  54. c  set nodes
  55. c
  56.    10 if (id.ge.21) go to 100
  57.       if (nnods(id).eq.0) go to 100
  58.       if (id.le.4) go to 20
  59.       if (id.le.8) go to 40
  60.       if (id.eq.19) go to 70
  61.    20 jstop=nnods(id)
  62.       do 30 j=1,jstop
  63.       call newnod(nodplc(loc+j+1),nodplc(loce+j+1),inodx(1),
  64.      1  inodi(1),nnodi)
  65.    30 continue
  66.       go to 100
  67.    40 call newnod(nodplc(loc+2),nodplc(loce+2),inodx(1),inodi(1),nnodi)
  68.       call newnod(nodplc(loc+3),nodplc(loce+3),inodx(1),inodi(1),nnodi)
  69.       if (id.ge.7) go to 100
  70.       nlocp=loc+id+1
  71.       nssnod=2*nodplc(loc+4)
  72.       call getm4(nodplc(loce+id+1),nssnod)
  73.       nlocpe=loce+id+1
  74.    50 do 60 j=1,nssnod
  75.       locp=nodplc(nlocp)
  76.       nodold=nodplc(locp+j)
  77.       call newnod(nodold,nodnew,inodx(1),inodi(1),nnodi)
  78.       locpe=nodplc(nlocpe)
  79.       nodplc(locpe+j)=nodnew
  80.    60 continue
  81.       go to 100
  82.    70 nlocp=loc+2
  83.       call sizmem(nodplc(loc+2),nssnod)
  84.       call getm4(nodplc(loce+2),nssnod)
  85.       nlocpe=loce+2
  86.       go to 50
  87. c
  88. c  copy real part
  89. c
  90.   100 if (nogo.ne.0) go to 300
  91.       locv=nodplc(loc+1)
  92.       locve=nodplc(loce+1)
  93.       call copy8(value(locv),value(locve),lval(id))
  94. c
  95. c  treat non-node tables specially
  96. c
  97.   200 if (id.ge.11) go to 300
  98.       go to (300,210,220,300,230,240,230,240,260,260), id
  99.   210 if (nodplc(loc+4).eq.1) go to 300
  100.       call cpytb8(loc+7,loce+7)
  101.       go to 300
  102.   220 if (nodplc(loc+4).eq.1) go to 300
  103.       call cpytb8(loc+10,loce+10)
  104.       go to 300
  105.   230 itab=5
  106.       go to 250
  107.   240 itab=6
  108.   250 if (id.le.6) go to 255
  109.       call cpytb4(loc+itab+1,loce+itab+1)
  110.   255 call cpytb4(loc+itab+2,loce+itab+2)
  111.       call cpytb8(loc+itab+3,loce+itab+3)
  112.       call cpytb8(loc+itab+4,loce+itab+4)
  113.       call cpytb4(loc+itab+5,loce+itab+5)
  114.       call cpytb8(loc+itab+6,loce+itab+6)
  115.       go to 300
  116.   260 call cpytb8(loc+5,loce+5)
  117. c
  118. c
  119.   300 return
  120.       end
  121.